A simple model for the estimation of the maximum percentage of deaths due to COVID-19.
NOTE: I’m not an epidiomiologist.
The prediction based on a simple logistic model and:
70% of SARS-CoV-2 exposure
10% Infection efficacy ie. 10% of the exposure subjects turns into a Covid-19 case
1% of Mortality
For each country we will use the urban population
I’ll estimate the death rates based on current trends fitted to the logistic function.
The last 14 days will be used for the peak estimations. Peak estimations will be done using:
If the data has not reached the peak the plots will show estimations based on:
If the data reached the peak the plots will show:
We are also providing optimistic models. We assume that the # of fatalities is one third the expected.
For Mexico we set the optimistic factor to 5. For every other country is set to 3.
Notes:
https://github.com/joseTamezPena/COVID_Forecasting
# The expetec % of deaths in each country
expectedtotalFatalities = 0.7*0.1*0.01
optGain <- 3
mexicoGain <- 5
# The number of observations used for the trends
daysWindow <- 14
currentdate <- "April 9:"
The data is the training set from: Kaggle: COVID19 Global Forecasting (Week 4)
https://www.kaggle.com/c/covid19-global-forecasting-week-4/data
Ploting some trends
Country_Region <- names(table(trainCountry$Country_Region))
totaldeaths <- numeric()
for (ctr in Country_Region)
{
totaldeaths <- append(totaldeaths,max(trainCountry[trainCountry$Country_Region == ctr,"Fatalities"]))
}
names(totaldeaths) <- Country_Region
totaldeaths <- totaldeaths[order(-totaldeaths)]
plot(trainCountry[trainCountry$Country_Region == names(totaldeaths[1]),"PerFatalities"],main="% Fatalities",xlab="Days",ylab=" % Fatalities")
for (ctr in names(totaldeaths[1:25]))
{
linp <- trainCountry[trainCountry$Country_Region == ctr,"PerFatalities"]
lines(linp)
text(length(linp)-1,linp[length(linp)],ctr)
}
totaldeaths <- totaldeaths[totaldeaths > 100]